home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH9 / SRC / CLIP.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-05-01  |  6.5 KB  |  209 lines
  1. VERSION 4.00
  2. Begin VB.Form PerspectiveForm 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Perspective Projection"
  6.    ClientHeight    =   5670
  7.    ClientLeft      =   1770
  8.    ClientTop       =   900
  9.    ClientWidth     =   5310
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   0
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    Height          =   6360
  21.    KeyPreview      =   -1  'True
  22.    Left            =   1710
  23.    LinkTopic       =   "Form1"
  24.    ScaleHeight     =   5670
  25.    ScaleWidth      =   5310
  26.    Top             =   270
  27.    Width           =   5430
  28.    Begin VB.CheckBox ClipCheck 
  29.       Caption         =   "Clip"
  30.       Height          =   255
  31.       Left            =   720
  32.       TabIndex        =   1
  33.       Top             =   5400
  34.       Width           =   735
  35.    End
  36.    Begin VB.PictureBox Pict 
  37.       AutoRedraw      =   -1  'True
  38.       Height          =   5295
  39.       Left            =   0
  40.       ScaleHeight     =   -14
  41.       ScaleLeft       =   -7
  42.       ScaleMode       =   0  'User
  43.       ScaleTop        =   7
  44.       ScaleWidth      =   14
  45.       TabIndex        =   0
  46.       Top             =   0
  47.       Width           =   5295
  48.    End
  49.    Begin VB.Label Label1 
  50.       Caption         =   "Distance to origin:"
  51.       Height          =   255
  52.       Index           =   0
  53.       Left            =   2160
  54.       TabIndex        =   3
  55.       Top             =   5400
  56.       Width           =   1575
  57.    End
  58.    Begin VB.Label RLabel 
  59.       BorderStyle     =   1  'Fixed Single
  60.       Height          =   255
  61.       Left            =   3720
  62.       TabIndex        =   2
  63.       Top             =   5400
  64.       Width           =   855
  65.    End
  66.    Begin VB.Menu mnuFile 
  67.       Caption         =   "&File"
  68.       Begin VB.Menu mnuFileExit 
  69.          Caption         =   "E&xit"
  70.       End
  71.    End
  72. Attribute VB_Name = "PerspectiveForm"
  73. Attribute VB_Creatable = False
  74. Attribute VB_Exposed = False
  75. Option Explicit
  76. ' Location of viewing eye.
  77. Dim EyeR As Single
  78. Dim EyeTheta As Single
  79. Dim EyePhi As Single
  80. Const Dtheta = PI / 20
  81. Const Dphi = PI / 20
  82. Const Dr = 1
  83. ' Location of focus point.
  84. Const FocusX = 0#
  85. Const FocusY = 0#
  86. Const FocusZ = 0#
  87. Dim Projector(1 To 4, 1 To 4) As Single
  88. ' *******************************************************
  89. ' Rotate the points in the cube and draw the cube.
  90. ' *******************************************************
  91. Private Sub DrawData(pic As Object)
  92. Dim i As Integer
  93. Dim x1 As Single
  94. Dim y1 As Single
  95. Dim z1 As Single
  96. Dim x2 As Single
  97. Dim y2 As Single
  98. Dim z2 As Single
  99. Dim do_clip As Boolean
  100. Dim draw_seg As Boolean
  101.     ' Prevent overflow errors when drawing lines
  102.     ' too far out of bounds.
  103.     On Error Resume Next
  104.     ' Transform the points.
  105.     TransformAllDataFull Projector
  106.     ' Display EyeR.
  107.     RLabel.Caption = Format(EyeR, "0.000")
  108.     ' Draw the points.
  109.     pic.Cls
  110.     do_clip = (ClipCheck.value = vbChecked)
  111.     draw_seg = True
  112.     For i = 1 To NumSegments
  113.         If do_clip Then
  114.             z1 = Segments(i).fr_tr(3)
  115.             z2 = Segments(i).to_tr(3)
  116.             ' Don't draw if either point is farther
  117.             ' from the focus point than the center of
  118.             ' projection (which is distance EyeR away).
  119.             draw_seg = (z1 < EyeR And z2 < EyeR)
  120.         End If
  121.         If draw_seg Then
  122.             x1 = Segments(i).fr_tr(1)
  123.             y1 = Segments(i).fr_tr(2)
  124.             x2 = Segments(i).to_tr(1)
  125.             y2 = Segments(i).to_tr(2)
  126.             pic.Line (x1, y1)-(x2, y2)
  127.         End If
  128.     Next i
  129.     pic.Refresh
  130. End Sub
  131. Private Sub ClipCheck_Click()
  132.     DrawData Pict
  133.     Pict.SetFocus
  134. End Sub
  135. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  136.     Select Case KeyCode
  137.         Case vbKeyLeft
  138.             EyeTheta = EyeTheta - Dtheta
  139.         
  140.         Case vbKeyRight
  141.             EyeTheta = EyeTheta + Dtheta
  142.         
  143.         Case vbKeyUp
  144.             EyePhi = EyePhi - Dphi
  145.         
  146.         Case vbKeyDown
  147.             EyePhi = EyePhi + Dphi
  148.                 
  149.         Case Else
  150.             Exit Sub
  151.     End Select
  152.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  153.     DrawData Pict
  154. End Sub
  155. Private Sub Form_KeyPress(KeyAscii As Integer)
  156.     Select Case KeyAscii
  157.         Case Asc("+")
  158.             EyeR = EyeR + Dr
  159.         
  160.         Case Asc("-")
  161.             EyeR = EyeR - Dr
  162.         
  163.         Case Else
  164.             Exit Sub
  165.     End Select
  166.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  167.     DrawData Pict
  168. End Sub
  169. Private Sub Form_Load()
  170.     ' Initialize the eye position.
  171.     EyeR = 10
  172.     EyeTheta = PI * 0.2
  173.     EyePhi = PI * 0.05
  174.     ' Initialize the projection transformation.
  175.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  176.     ' Create the data.
  177.     CreateData
  178.     ' Project and draw the data.
  179.     DrawData Pict
  180. End Sub
  181. Sub CreateData()
  182. Const WID = 1
  183. Dim x As Single
  184. Dim y As Single
  185. Dim z As Single
  186.     ' Create the cubes.
  187.     For x = -3 To 3 Step 6
  188.         For y = -3 To 3 Step 6
  189.             For z = -3 To 3 Step 6
  190.                 MakeSegment x - WID, y - WID, z - WID, x - WID, y - WID, z + WID
  191.                 MakeSegment x - WID, y - WID, z + WID, x - WID, y + WID, z + WID
  192.                 MakeSegment x - WID, y + WID, z + WID, x - WID, y + WID, z - WID
  193.                 MakeSegment x - WID, y + WID, z - WID, x - WID, y - WID, z - WID
  194.                 MakeSegment x + WID, y - WID, z - WID, x + WID, y - WID, z + WID
  195.                 MakeSegment x + WID, y - WID, z + WID, x + WID, y + WID, z + WID
  196.                 MakeSegment x + WID, y + WID, z + WID, x + WID, y + WID, z - WID
  197.                 MakeSegment x + WID, y + WID, z - WID, x + WID, y - WID, z - WID
  198.                 MakeSegment x - WID, y - WID, z - WID, x + WID, y - WID, z - WID
  199.                 MakeSegment x - WID, y - WID, z + WID, x + WID, y - WID, z + WID
  200.                 MakeSegment x - WID, y + WID, z + WID, x + WID, y + WID, z + WID
  201.                 MakeSegment x - WID, y + WID, z - WID, x + WID, y + WID, z - WID
  202.             Next z
  203.         Next y
  204.     Next x
  205. End Sub
  206. Private Sub mnuFileExit_Click()
  207.     Unload Me
  208. End Sub
  209.